perm filename DPYXGP.SAI[X,ALS] blob
sn#078547 filedate 1973-12-22 generic text, type T, neo UTF8
00100 BEGIN "DPYXGP"
00200
00300 REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
00400 REQUIRE "TTYSUB.HDR[1,PDQ]" SOURCE_FILE;
00500 REQUIRE "BOLIB.HDR[1,BO]" SOURCE_FILE;
00600
00700 SIMPROC BREAK;BEGIN END;
00800
00900
01000 DEFINE XGPWID="1700",LMAR="50",RMAR="(XGPWID-50)",SCL="(1600/1400)";
01100
01200 INTEGER SIMPROC SCLFN(INTEGER X);RETURN(SCL*(X+700));
01300
01400 INTEGER VECMAX;
01500 DEFINE STRMAX="350";
01600 DEFINE PTWID="0";
01700
01800 PRELOAD_WITH "FIX13X","FIX20","FIX20","FIX25","FIX40","BDR40","SIGN57";
01900 STRING ARRAY FONTNAME[1:7];
02000
02100 PRELOAD_WITH 10,12,12,16,25,25,50;
02200 INTEGER_ARRAY FONTSIZE[1:7];
02300
02400 PRELOAD_WITH 8,12,14,16,24,32,48;
02500 INTEGER_ARRAY CHSIZES[1:7];
02600
02700 SAFE BOOLEAN ARRAY CHTAB[1:7];
02800
02900 INTEGER SIMPROC XTEND(INTEGER X,MSK);
03000 START_CODE MOVE 1,X;MOVE 2,MSK;TDNE 1,2;ORCMI 1,-1(2);END;
03100
03200 INTEGER VARWID,VECWID;
03300
00100 PROCEDURE DPYXGP(INTEGER_ARRAY DPYBUF;STRING ODEV);
00200 BEGIN
00300 INTEGER_ARRAY Y0,PV,X0,XN,YN,WS[1:VECMAX];
00400 INTEGER_ARRAY PS,YS,XS,CS[1:STRMAX];
00500 STRING_ARRAY STRS[1:STRMAX];
00600 INTEGER YMIN,YMAX;
00700 INTEGER BUFMAX,X,Y,I,J,JS,CHSIZ;
00800
00900
01000 SIMPROC MKVEC(INTEGER C,VX,VY);
01100 BEGIN LABEL L;
01200 IF C≥4 THEN C←C LAND 3
01300 ELSE BEGIN VX←X+VX;VY←Y+VY;END;
01400 CASE C OF
01500 BEGIN
01600 BEGIN "VISIBLE VECTOR"
01700 INTEGER YT,XT,YB,XB,S,SN,DX,DY;
01800 YT←SCLFN(Y);XT←SCLFN(X);YB←SCLFN(VY);XB←SCLFN(VX);
01900 ⊃ larger Y coordinate at top;
02000 IF YB>YT∨YB=YT∧XB<XT THEN BEGIN YT↔YB;XT↔XB;END;
02100 DX←XT-XB;DY←YT-YB;
02200 SN←IF 10*ABS(DY)<ABS(DX) ∧ DY≠0 THEN VECWID ELSE 1;
02300 IF XT<0∧XB<0∨XT>RMAR∧XB>RMAR THEN GO TO L;
02400 IF XT>RMAR THEN BEGIN XT←RMAR;YT←YB+DY*(RMAR-XB)/DX;END
02500 ELSE IF XT<0 THEN BEGIN XT←0;YT←YB-DY*XB/DX;END;
02600 DX←XT-XB;DY←YT-YB;
02700 IF XB>RMAR THEN BEGIN XB←RMAR;YB←YT+DY*(RMAR-XT)/DX;END
02800 ELSE IF XB<0 THEN BEGIN XB←0;YB←YT-DY*XT/DX;END;
02900
03000 FOR S←1 STEP 1 UNTIL SN DO
03100 BEGIN Y0[J]←YT;X0[J]←XT;YN[J]←YB;XN[J]←XB;
03200 WS[J]←IF SN=1 THEN VECWID ELSE 1;
03300 PV[J]←J;J←J+1;YT←YT-1;YB←YB-1;
03400 END;
03500 L: END "VISIBLE VECTOR";
03600 BEGIN "ENDPOINT VECTOR"
03700 YN[J]←Y0[J]←SCLFN(VY);XN[J]←X0[J]←SCLFN(VX);
03800 WS[J]←VECWID+2;PV[J]←J;J←J+1;
03900 END "ENDPOINT VECTOR";
04000 BEGIN ⊃ INVISIBLE VECTOR; END;
04100 BEGIN ⊃ UNUSED; END;
04200 END;
04300 X←VX;Y←VY;
04400 YMAX←SCLFN(Y) MAX YMAX;YMIN←SCLFN(Y) MIN YMIN;
04500 END "MKVEC";
04600
04700 SIMPROC MKSVEC(INTEGER WD);
04800 MKVEC(WD LAND 3,
04900 XTEND(LDB(POINT(7,WD,26)),'100),
05000 XTEND(LDB(POINT(7,WD,33)),'100));
05100
05200 SIMPROC XGPSTR(STRING S);
05300 BEGIN INTEGER CHSZ,N,CHWID,XX,L,K,C;
05400 STRING TS;
05500 CHTAB[CHSIZ]←TRUE;
05600 CHSZ←CHSIZES[CHSIZ];
05700 CHWID←FONTSIZE[CHSIZ];
05800 XX←XS[JS]←SCLFN(X-CHSZ DIV 2);
05900 YS[JS]←SCLFN(Y+CHSZ);PS[JS]←JS;
06000 TS←NULL;WHILE S DO IF (C←LOP(S))=0 THEN DONE ELSE TS←TS&C;
06100 S←TS;
06200 N←(L←LENGTH(S)) MIN ((RMAR-XX) DIV CHWID);
06300 K←IF XX<0 THEN -XX DIV CHWID+1 ELSE 1;
06400 IF XX<0 THEN XX←0;
06500 IF N<L THEN BEGIN OUTSTR("PAGE OVERFLOW WITH STRING="&S);OUTSTR(CRLF);END;
06600 IF N<1∨K>N THEN BEGIN OUTSTR("N= "&
06650 CVS(N)&" L= "&CVS(L)&" K= "&CVS(K)&" S= "&S&CRLF);RETURN;END;
06700 STRS[JS]←S[K TO N];
06800 CS[JS]←CHSIZ;JS←JS+1;
06900 X←X+CHSZ*L;
07000 END "XGPSTR";
07100
07200
00100 BEGIN "IIICVT"
00200 INTEGER OP,IIIWD;
00300 IARRCLR(Y0,1 LSH 35);
00400 IARRCLR(YS,1 LSH 35);
00500 IARRCLR(CHTAB,FALSE);
00600
00700 BUFMAX←ARRINFO(DPYBUF,0);
00800 J←JS←1;
00900 CHSIZ←2;
01000 YMIN←2200;YMAX←0;
01100 X←Y←0;
01200 FOR I←1 STEP 1 UNTIL BUFMAX DO
01300 BEGIN
01400 IIIWD←DPYBUF[I];
01500 OP←IIIWD LAND '17;
01600 IF IIIWD LAND 1 THEN
01700 BEGIN
01800 STRING STR;
01900 STR←CVSTR(IIIWD);
02000 WHILE (IIIWD←DPYBUF[I+1]) LAND 1 DO
02100 BEGIN I←I+1;STR←STR&CVSTR(IIIWD);END;
02200 XGPSTR(STR)
02300 END
02400 ELSE IF OP=2 THEN
02500 BEGIN "SHORT VECTORS"
02600 MKSVEC(IIIWD LSH -'24);
02700 MKSVEC(IIIWD LSH -4);
02800 END "SHORT VECTORS"
02900 ELSE IF OP=6 THEN
03000 BEGIN "LONG VECTOR"
03100 INTEGER C;
03200 C←LDB(POINT(3,IIIWD,27));
03300 IF C THEN CHSIZ←C;
03400 C←LDB(POINT(3,IIIWD,24));
03500 IF VARWID∧C THEN VECWID←C;
03600 MKVEC(LDB(POINT(3,IIIWD,31)),
03700 XTEND(LDB(POINT(11,IIIWD,10)),'2000),
03800 XTEND(LDB(POINT(11,IIIWD,21)),'2000));
03900 END "LONG VECTOR";
04000 IF J>VECMAX THEN BEGIN OUTSTR("TOO MANY VECTORS"&CRLF);DONE;END;
04100 END;
04200
04300 ⊃ now the vector and string lists have been constructed;
04400
04500 J←J-1;JS←JS-1;
04600
04700 END "IIICVT";
04800 SORT(Y0,PV); ⊃ sort the vectors;
04900 SORT(YS,PS); ⊃ sort the strings;
05000
00100 IFC FALSE THENC
00200 BEGINC
00300 BEGIN INTEGER I,K;
00400 INTEGER_ARRAY DPYBUF[1:2000];
00500 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00600 DPYSET(DPYBUF);
00700 FOR I←1 STEP 1 UNTIL J DO
00800 BEGIN
00900 K←PV[I];
01000 GVECT(X0[K],Y0[I],'146,0,WS[K]);
01100 AVECT(XN[K],YN[K]);
01200 END;
01300 FOR I←1 STEP 1 UNTIL JS DO
01400 BEGIN K←PS[I];
01500 GVECT(XS[K],YS[I],'146,CS[K],0);
01600 DPYSST(STRS[K]);
01700 END;
01800 DPYOUT(1);
01900 END;
02000 ENDC;
02100
00100 BEGIN "XGPOUT"
00200
00300 INTEGER CHN,JMAX,JSMAX,K,I,N,DX,WX,WID,VECWID,WX2,VW2;
00400
00500 INTEGER CCNT,OUTWD,XG,FSL,YOFF,YBOT;
00600
00700 SIMPROC COUT(INTEGER C);
00800 IF XG=0 THEN OUT(CHN,C )
00900 ELSE
01000 BEGIN
01100 INTEGER PT;
01200 IF CCNT=0 THEN BEGIN WORDOUT(CHN,OUTWD);OUTWD←0;CCNT←5;PT←POINT(7,OUTWD,-1);END;
01300 IDPB(C,PT);CCNT←CCNT-1;
01400 END;
01500
01600 SIMPROC XOUT(INTEGER X);
01700 BEGIN X←((X+LMAR) MAX 0) MIN XGPWID;
01800 COUT(X LSH -7);COUT(X);
01900 END "XOUT";
02000
02100 INTEGER YLAST,STAT;
02200
02300 SIMPROC YOUT(INTEGER Y);
02400 BEGIN Y←YOFF-Y;
02500 Y←(Y MAX 0) MIN YBOT;
02600 IF Y<YLAST THEN OUTSTR("VECTORS OUT OR ORDER"&CRLF);
02700 YLAST←Y;
02800 COUT(Y LSH -7);COUT(Y);
02900 END "YOUT";
03000
03100 BOOLEAN SIMPROC MTAP(INTEGER CHN,ADR);
03200 START_CODE
03300 HRLZ 2,CHN;LSH 2,5;TLO 2,'072000;HRR 2,ADR;MOVEI 1,0;XCT 2;SETOM 1;
03400 END "MTAP";
03500
03600 INTEGER PROCEDURE XGPSTAT;
03700 BEGIN INTEGER_ARRAY BLK[0:4];
03800 BLK[0]←0;
03900 MTAP(CHN,LOC(BLK[0])); ⊃ GET XGP STATUS;
04000 IF BLK[1]≠0 THEN
04100 OUTSTR("XGP LOSSAGE, STATUS BITS="&CVOS(BLK[1])&
04200 ","&CVOS(BLK[2])&","&CVOS(BLK[3])&CRLF);
04300 RETURN(BLK[1]);
04400 END "XGPSTAT";
04500
04600 PROCEDURE FONTSEL(INTEGER I;STRING FNAM);
04700 BEGIN INTEGER_ARRAY BLK[0:4];
04800 BLK[0]←1;BLK[1]←CVSIX(FNAM);BLK[2]←CVSIX("FNT");BLK[3]←CVSIX("XGPSYS");
04900 BLK[4]←I;
05000 MTAP(CHN,LOC(BLK[0]));
05100 XGPSTAT;
05200 END "FONTSEL";
05300
05400 XG←IF ODEV="XGP" THEN 0 ELSE '14;
05500 CHN←GETCHAN;
05600 OPEN(CHN,ODEV,XG,0,4,0,0,0);
05700 ENTER(CHN,"X.X",0);
05800 IF XG=0 THEN FOR I←1 STEP 1 UNTIL 7 DO
05900 IF CHTAB[I] THEN FONTSEL(I,FONTNAME[I]);
06000
06100 JMAX←J+1;JSMAX←JS+1;
06200 CCNT←0;
06300 J←JS←1;
06400 FSL←0;
06500 YOFF←IF YMAX<1950∧YMIN>0 THEN 1950
06600 ELSE IF YMAX-YMIN≤2200 THEN 1100-(YMAX+YMIN) DIV 2
06700 ELSE YMAX;
06800 BEGIN INTEGER_ARRAY BLK[0:6];
06900 BLK[0]←3;
07000 YBOT←BLK[2]←IF YMAX-YMIN>2200 THEN YMAX-YMIN ELSE 2200;
07100 BLK[3]←1;
07200 BLK[5]←4000;
07300 MTAP(CHN,LOC(BLK[0]));
07400 END;
07500
07600 YLAST←0;
07700 WHILE TRUE DO
07800 BEGIN
07900 IF J≥JMAX∧JS≥JSMAX THEN DONE;
08000 WHILE J<JMAX ∧ (JS≥JSMAX∨Y0[J]≥YS[JS]) DO
08100 BEGIN INTEGER XL;
08200 PROCEDURE LINOUT(INTEGER X,Y,DX,N,WID);
08300 BEGIN
08400 COUT('177);COUT(4);
08500 YOUT(Y);XOUT(XL);
08600 COUT(DX LSH -14);COUT(DX LSH -7);COUT(DX);
08700 COUT(N LSH -7);COUT(N);
08800 COUT(WID LSH -7);COUT(WID);
08900 END "LINOUT";
09000 K←PV[J];
09100 VECWID←WS[K];
09200 VW2←VECWID DIV 2;
09300 XL←X0[K];
09400 WX←(XN[K]-X0[K]);
09500 WX2←IF WX<0 THEN WX-VECWID ELSE WX+VECWID;
09600 N←(Y0[J]-YN[K])+1; ⊃ guaranteed to be >0;
09700 IF N>ABS(WX)+1 THEN
09800 BEGIN DX←(WX LSH 9) DIV (N-1);
09900 WID←ABS(DX)*VECWID LSH -9+VECWID;
10000 IF DX<0 THEN XL←XL-VW2;
10100 END
10200 ELSE IF N>1 THEN
10300 BEGIN DX← (WX2 LSH 9) DIV N;
10400 WID←ABS(DX)*VECWID LSH -9+VECWID;
10500 ⊃ N←N+1-VECWID;
10600 IF DX<0 THEN XL←XL-(WID+DX DIV 700)+VECWID;
10700 END
10800 ELSE BEGIN DX←0;
10900 WID←ABS(WX2);
11000 N←VECWID;
11100 END;
11200 XL←XL-VW2;
11300 LINOUT(XL,Y0[J],DX,N,WID);
11400 J←J+1;
11500 END;
11600 WHILE JS<JSMAX ∧ (J≥JMAX∨YS[JS]≥Y0[J]) DO
11700 BEGIN STRING S;
11800 INTEGER X,C,CH;
11900 K←PS[JS];
12000 C←CS[K];
12100 IF FSL≠C THEN
12200 BEGIN FSL←CS[K]; ⊃ SET FONT;
12300 COUT('177);COUT(1);COUT(FSL);
12400 END;
12500 COUT('177);COUT(3); ⊃ SET SCAN LINE NUMBER;
12600 YOUT(YS[JS]);
12700 COUT('177);COUT(1);COUT('40); ⊃ SET COLUMN NUMBER;
12800 XOUT(X←XS[K]);
12900 S←STRS[K];
13000 WHILE S DO
13100 BEGIN CH←LOP(S);IF CH=NULL THEN DONE;COUT(CH);END;
13200 COUT(LF);
13300 JS←JS+1;
13400 END;
13500 END;
13600
13700 IF XG∧CCNT>0 THEN WORDOUT(CHN,OUTWD);
13800 CLOSE(CHN);
13900 STAT←XGPSTAT;
14000 RELEASE(CHN);
14100
14200 END "XGPOUT";
14300 END "DPYXGP";
14400
00100 BEGIN "XGPRUN"
00200 STRING FILE,ODEV;
00300 INTEGER CHN,FLG,MFLG,SIZE,FOO;
00400 VECWID←1; ⊃ VECWID←ININT("LINE WIDTH←");
00500 VARWID←VECWID=0;
00600 IF VARWID THEN VECWID←2;
00700
00800 ODEV←"XGP"; ⊃ ODEV←STRIN("OUTPUT DEVICE=");
00900 WHILE TRUE DO
01000 BEGIN OPEN(CHN←GETCHAN,"DSK",'14,1,0,0,0,0);
01100 WHILE TRUE DO
01200 BEGIN FILE←"PLOTX.GRF[X,ALS]"; ⊃ FILE←STRIN("FILE=");
01300 LOOKUP(CHN,FILE,FLG);IF FLG=0 THEN DONE;
01400 LOOKUP(CHN,FILE&".GRF",FLG);IF FLG=0 THEN DONE;
01500 END;
01600 FOO←WORDIN(CHN);SIZE←WORDIN(CHN);WORDIN(CHN);
01700 BEGIN
01800 INTEGER_ARRAY DPYBUF[1:SIZE+2];
01900 ARRYIN(CHN,DPYBUF[1],SIZE+1);
02000 VECMAX←2*SIZE;
02100 RELEASE(CHN);
02200 DPYXGP(DPYBUF,ODEV);
02300 END;
02400
02500 END;
02600 END "XGPRUN";
02700
02800 END "DPYXGP";
02900
03000